home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1999 March / EnigmA AMIGA RUN 35 (1999)(G.R. Edizioni)(IT)[!][issue 1999-03].iso / earkit / mail / thor / thor25_arexx.lha / ShowHTML.thor < prev    next >
Text File  |  1997-09-02  |  8KB  |  336 lines
  1. /*
  2. ** $VER: ShowHTML.thor 1.1 (2.9.97)
  3. **
  4. ** by Eirik Nicolai Synnes <eirikns@ifi.uio.no>
  5. **
  6. ** ShowHTML.thor will send a HTML document in the message currently displayed
  7. ** in Thor's main window to a web browser.  First it searches for a browser
  8. ** already in memory and uses this one, uniconifying it if necessary.  If no
  9. ** browser is active it will launch the browser configured using CfgHTTP.thor.
  10. **
  11. ** Currenly ShowHTML.thor recognizes IBrowse, AWeb, Voyager and AMosaic.
  12. **
  13. **
  14. ** New in 1.1:
  15. **
  16. **   o HTML search routines vastly improved
  17. **   o Added support for Voyager (2.88 tested, might not work with earlier
  18. **     versions)
  19. **   o Added support for AMosaic (not tested)
  20. **   o Now uses CfgHTTP.thor's configuration file to figure out how to start
  21. **     the browser
  22. **   o Browser window is always brought to front and activated (if the
  23. **     browser's ARexx port support it)
  24. **   o Lots of minor enhancements and bug fixes
  25. **
  26. **
  27. ** Todo:
  28. **
  29. **   o Delete shows "Delete returned 20" if it couldn't delete the temporary
  30. **     file. Is it possible to get rid of this?
  31. **
  32. **   o Figure out a flexible method to support inline pictures
  33. **        (
  34. **          Netscape:
  35. **          <IMG SRC="cid:picid">
  36. **          Picture attachment has Content-ID:<picid>
  37. **        )
  38. **
  39. */
  40.  
  41. options results
  42. options failat 31
  43.  
  44. signal on break_c
  45. signal on halt
  46. signal on error
  47.  
  48. globals = 'fileopen filename outfile THOR.LASTERROR BBSREAD.LASTERROR thorport msgtext. wwwcmd wwwport globals'
  49.  
  50. fileopen = 0
  51. filename = 'T:SaveHTML.' || pragma('ID') || '.html'
  52.  
  53.  
  54. /*
  55. ** See if I'm run from Thor
  56. */
  57.  
  58. if (left(address(), 5) = 'THOR.') then thorport = address()
  59. else do
  60.     say 'This script must be run from Thor.'
  61.     exit(20)
  62.     end
  63.  
  64.  
  65. /*
  66. ** Find/open BBSREAD ARexx port
  67. */
  68.  
  69. if ~(show('P', 'BBSREAD')) then do
  70.     address(command)
  71.     'Run >NIL: `GetEnv THOR/THORPath`bin/LoadBBSRead'
  72.     'WaitForPort BBSREAD'
  73.     if (rc ~= 0) then displayerror(30, 'SortMail', 'Couldn''t open BBSREAD''s ARexx port.')
  74.     end
  75.  
  76. call loadprefs()
  77.  
  78. /*
  79. ** Read the current message
  80. */
  81.  
  82. address(thorport)
  83. 'CURRENTMSG STEM 'curmsg
  84. if (rc ~= 0) then call fail('Couldn''t detect a current message.')
  85.  
  86. address(bbsread)
  87. 'READBRMESSAGE "'curmsg.BBSNAME'" "'curmsg.CONFNAME'" 'curmsg.MSGNR' TEXTSTEM 'msgtext
  88. if (rc ~= 0) then call fail('Couldn''t read message:\n'BBSREAD.LASTERROR)
  89.  
  90.  
  91. /*
  92. ** Find out what browser(s) is/are active
  93. */
  94.  
  95. call findbrowser()
  96.  
  97. /*
  98. ** Find a text/html part
  99. */
  100.  
  101. if ~(findhtml('msgtext')) then do
  102.     if (symbol('msgtext.TEXT.COUNT') = 'VAR') & (msgtext.TEXT.COUNT > 0) then do
  103.         address(thorport)
  104.         'REQUESTNOTIFY TEXT "No text/html message part found.\nDo you want to send the first\nmessage part to the browser?" BT "Yes|No"'
  105.         if (rc ~= 0) then do
  106.             say 'Couldn''t open requester: 'THOR.LASTERROR
  107.             exit(0)
  108.         end
  109.         if (result = 1) then call savemsg('msgtext')
  110.         else exit(0)
  111.     end
  112.     else fail('No text/html message part found.')
  113. end
  114.  
  115.  
  116. /*
  117. ** Display HTML document
  118. */
  119.  
  120. if symbol('wwwport') ~= 'VAR' then do
  121.     address command 'Run <NIL: >NIL: 'wwwcmd' file://localhost/' || filename
  122.     if rc ~= 0 then fail('Failed to run browser.')
  123. end
  124. else do
  125.     address(wwwport)
  126.     select
  127.         when wwwport = 'VOYAGER' then 'OPENURL file://localhost/' || filename
  128.         when wwwport = 'IBROWSE' then 'GOTOURL file://localhost/' || filename
  129.         when left(wwwport, 5) = 'AWEB.' then 'OPEN URL file://localhost/' || filename || ' RELOAD'
  130.         when left(wwwport, 8) = 'AMOSAIC.' then 'JUMP URL file://localhost/' || filename
  131.         otherwise nop
  132.     end
  133.     if (rc ~= 0) then call fail('Browser failed to display document.')
  134. end
  135.  
  136.  
  137. /*
  138. ** Activate browser window
  139. */
  140.  
  141. if (symbol('wwwport') ~= 'VAR') then call findbrowser
  142.  
  143. address(wwwport)
  144.  
  145. select
  146.     when (wwwport = 'VOYAGER') then do
  147.         'SHOW'
  148.         'ACTIVATE'
  149.     end
  150.     when (wwwport = 'IBROWSE') then do
  151.         'SHOW'
  152.         'SCREENTOFRONT'
  153.         'ACTIVATE'
  154.     end
  155.     when (left(wwwport, 5) = 'AWEB.') then do
  156.         'WINDOWTOFRONT'
  157.         'SCREENTOFRONT'
  158.         'ACTIVATEWINDOW'
  159.     end
  160.     when (left(wwwport, 8) = 'AMOSAIC.') then do
  161.         'SHOW'
  162.         'ACTIVATE'
  163.     end
  164.     otherwise nop
  165. end
  166.  
  167. /*
  168. ** Clean up and exit
  169. */
  170.  
  171. cleanup:
  172. break_c:
  173. halt:
  174. error:
  175.  
  176. if fileopen = 1 then call close(outfile)
  177.  
  178.  
  179. /*
  180. ** See if the file can be deleted. Checks every 10 seconds.
  181. */
  182.  
  183. if exists(filename) then do
  184.     address(command)
  185.     'Wait 20'
  186.     do i = 1 to 6
  187.         'Wait 10'
  188.         'Delete >NIL: "'filename'"'
  189.         if (rc = 0) then leave i
  190.     end
  191. end
  192.  
  193. exit(0)
  194.  
  195.  
  196. /****************************************************************************
  197. ********************************** Procedures ********************************
  198.  ***************************************************************************/
  199.  
  200.  
  201. /**
  202. *** Find the first text/html part
  203. **/
  204.  
  205. findhtml: interpret 'procedure expose 'globals
  206.           parse arg tstem
  207.  
  208. foundct = 0
  209.  
  210. if (symbol(tstem'.COMMENT.COUNT') = 'VAR') & (value(tstem'.COMMENT.COUNT') > 0) then do i = 1 to value(tstem'.COMMENT.COUNT') while foundct = 0
  211.     curline = upper(value(tstem'.COMMENT.i'))
  212.     if (subword(curline, 1, 1) = 'CONTENT-TYPE:') & (compress(subword(curline, 2, 1), ';') = 'TEXT/HTML') then foundct = 1
  213. end
  214.  
  215. if (upper(value(tstem'.BINARY.DESC')) = 'TEXT/HTML') then foundct = 1
  216.  
  217. if foundct = 1 then do
  218.     call savemsg(tstem)
  219.     return(1)
  220. end
  221. else if (symbol(tstem'.PART.COUNT') = 'VAR') & (value(tstem'.PART.COUNT') > 0) then do i = 1 to value(tstem'.PART.COUNT')
  222.     newstem = tstem || '.PART.' || i || '.MSG'
  223.     call findhtml(newstem)
  224.     if (result = 1) then return(1)
  225. end
  226.  
  227. return(0)
  228.  
  229.  
  230.  
  231. /**
  232. *** Save a messagepart to disk
  233. **/
  234.  
  235. savemsg: interpret 'procedure expose 'globals
  236.             parse arg htmltext
  237.  
  238. /* Write text body */
  239.  
  240. if (symbol(htmltext'.TEXT.COUNT') = 'VAR') then do
  241.     cnt = value(htmltext'.TEXT.COUNT')
  242.  
  243.     if (cnt > 0) then do
  244.         fileopen = open(outfile, filename, 'W')
  245.         if ~(fileopen) then do
  246.             call fail('Couldn''t open "' || filename || '" for writing.')
  247.             return(20)
  248.         end
  249.         do i = 1 to cnt
  250.             call writeln(outfile, value(htmltext'.TEXT.'i))
  251.         end
  252.         call close(outfile)
  253.     end
  254.  
  255.     else if (symbol(htmltext'.PART.1.BINARY') = 'VAR') & (value(htmltext'.PART.1.BINARY.DESC') = 'text/html') then do
  256.         htmlpath = value(htmltext'.PART.1.BINARY')
  257.         if ~(exists(htmlpath)) then fail('text/html part was deleted or not found.')
  258.         else address command 'Copy "'htmlpath'" TO "'filename'" QUIET'
  259.     end
  260.  
  261.     else fail('text/html part was empty.')
  262. end
  263.  
  264. return(0)
  265.  
  266.  
  267. /*
  268. ** Find an active browser, run one if none is found
  269. */
  270.  
  271. findbrowser: interpret 'procedure expose 'globals
  272.  
  273. /* Go through available ports */
  274.  
  275. ports = show('P')
  276.  
  277. do i = 1 to words(ports)
  278.     if left(subword(ports, i), 5) = 'AWEB.'    then wwwport = subword(ports, i, 1)
  279.     if left(subword(ports, i), 8) = 'AMOSAIC.' then wwwport = subword(ports, i, 1)
  280.     if left(subword(ports, i), 7) = 'VOYAGER'  then wwwport = subword(ports, i, 1)
  281.     if left(subword(ports, i), 7) = 'IBROWSE'  then wwwport = subword(ports, i, 1)
  282.     if symbol('wwwport') = 'VAR' then break
  283. end
  284.  
  285. if left(subword(ports, i), 5) = 'AWEB.' then do
  286.     address(wwwport)
  287.     'GET ACTIVEPORT'
  288.     if (rc = 0 ) then wwwport = result
  289. end
  290.  
  291. return(0)
  292.  
  293.  
  294. /*
  295. ** Display an error message and exit
  296. */
  297.  
  298. fail: procedure expose interpret 'procedure expose 'globals
  299.       parse arg errtext
  300.  
  301. address(thorport)
  302.  
  303. 'REQUESTNOTIFY TEXT "'errtext'" BUTTONTEXT "Abort"'
  304. if (rc ~= 0) then do
  305.     say 'Couldn''t open error requester: 'THOR.LASTERROR
  306.     say 'Original error was: 'errtext
  307. end
  308.  
  309. signal cleanup
  310.  
  311.  
  312. /*
  313. ** Load preferences saved by CfgHTTP.thor
  314. */
  315.  
  316. loadprefs: interpret 'procedure expose 'globals
  317.  
  318. cfgfile = 'ENV:Thor/http.config'
  319.  
  320. if ~(exists(cfgfile)) then do
  321.     address(thorport)
  322.     'REQUESTNOTIFY TEXT "Could not find the configuration file.\nRun CfgHTTP to create one or quit." BT "CfgHTTP|Quit"'
  323.     if (rc = 0) & (result = 1) then address command 'rx `GetEnv THOR/THORPath`rexx/cfghttp.thor'
  324.     exit(0)
  325. end
  326. else do
  327.     call open(prf, cfgfile, 'R')
  328.     do until eof(prf)
  329.         line = readln(prf)
  330.         if upper(word(line, 1)) = 'BROWSEREXE' then wwwcmd = subword(line, 2)
  331.     end
  332.     call close(prf)
  333. end
  334.  
  335. return(0)
  336.